home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / swag / egavga.swg / 0166_Full VGA Fonts with Protected Mode.pas < prev    next >
Pascal/Delphi Source File  |  1994-11-30  |  12KB  |  241 lines
  1. Unit LF;
  2.  
  3. {$IFDEF Windows}
  4. !! - Bite me!  This will not work with Windows!
  5. {$ENDIF}
  6.  
  7. { Text-mode font routines                                                    }
  8. { (c)1994 Chris Lautenbach                                                   }
  9. {                                                                            }
  10. { Date         Revision     Description                                      }
  11. { ────────────────────────────────────────────────────────────────────────── }
  12. { Sep 07 94         1.0     Wrote real mode routines                         }
  13. { Sep 09 94         1.1     Added protected mode versions                    }
  14. { Sep 11 94         1.2     Added Set2FontMode() and SetNormalFontMode()     }
  15.  
  16. { Notes:                                                                     }
  17.  
  18. { It is important to note, that under protected mode, the normal VGA BIOS    }
  19. { extensions could not access the memory procured by GetMem().  This is why  }
  20. { the SimulateRealModeInt() and XGlobalDosAlloc() routines were needed.      }
  21. { XGlobalDosAlloc() allocates memory under the 1mb mark that the VGA BIOS is }
  22. { capable of accessing, and thereby allows font loads in p-mode.             }
  23.  
  24. { Any size/line font may be used.  This is because I used subfunction $11    }
  25. { instead of $10.  $11 will calculate the scanlines/etc required for the     }
  26. { font you are loading by dividing the number of characters by the fonts     }
  27. { total size (as does LoadFont(), so that we may properly allocate memory).  }
  28. { I've tested 25, 33, 50, and 66 line mode fonts with it and they all work   }
  29. { fine.  Make sure the font you are loading is _pure_ binary, and does not   }
  30. { contain header information for some sort of font editing/loading program.  }
  31.  
  32. { The calls to LoadFont() are identical in p-mode to real mode, so you won't }
  33. { need to do any code changes should you decide to switch between the modes  }
  34. { later on.  Nor is any special setup necessary.  Just USE it, and load      }
  35. { fonts, that's it! :)                                                       }
  36.  
  37. { Using the VGA's 2 font mode:                                               }
  38.  
  39. { The variable LoadBank has been provided so you can use LoadFont() to load  }
  40. { a font into a different font bank (VGA has up to 8 slots, 0-7).  The new   }
  41. { Set2FontMode() procedure allows you to switch to this mode.                }
  42. { SetNormalFontMode should be called to return you to normal mode.  To use   }
  43. { this mode, you must use two identical line mode fonts (eg. 25 line and 25  }
  44. { line, 50 and 50, etc).  One must be loaded into bank 0, and the other must }
  45. { be loaded into bank 6 (don't ask me why.. :).  Any characters that are     }
  46. { displayed in low intensity will be displayed in the font in bank 6, and    }
  47. { high intensity characters will be displayed in bank 0's font (the normal   }
  48. { font if you haven't changed it.                                            }
  49.  
  50. { Restrictions:                                                              }
  51.  
  52. { It is _ASSUMED_ that the machine has a VGA adapter.  If it does not, god   }
  53. { only knows what will happen.  It is up to you to make sure a VGA is        }
  54. { present before calling these routines.                                     }
  55.  
  56. { Don't you dare use this code for profit without proclaiming my name in a   }
  57. { prominent place in your program!  :) (Oh, and it don't work under Windoze  }
  58. { but I'm sure you knew that...)                                             }
  59.  
  60. { Oh, and I'm not an artist.  If you want to pay me for these routines,      }
  61. { leave me e-mail to viper@ttcbbs.com.                                       }
  62.  
  63. INTERFACE
  64.  
  65. {$IFDEF DPMI}
  66. Uses WinApi;
  67. {$ENDIF}
  68.  
  69. function LoadFont(FileName : string) : boolean;
  70. { Loads a 255-character font from FileName to font 0 and sets it on }
  71.  
  72. procedure NormalFont;
  73. { Returns the system to the normal system 8x16 character font }
  74.  
  75. procedure Set2FontMode;
  76. { Sets the VGA to allow 2 fonts simulataneously displayed }
  77.  
  78. procedure SetNormalFontMode;
  79. { Returns the VGA to normal single font mode }
  80.  
  81. var LoadBank : byte;                      { Default bank # to load font into }
  82.  
  83. IMPLEMENTATION
  84.  
  85. {$IFDEF DPMI}
  86. Type LongRec = record
  87.        Selector, Segment : word;
  88.      end;
  89.  
  90.      DoubleWord = record
  91.        Lo, Hi : word;
  92.      end;
  93.  
  94.      QuadrupleByte = record
  95.        Lo, Hi, sLo, sHi : byte;
  96.      end;
  97.  
  98.      TDPMIRegisters = record
  99.        EDI, ESI, EBP, Reserved, EBX, EDX, ECX, EAX : longint;
  100.        Flags, ES, DS, FS, GS, IP, CS, SP, SS : word;
  101.      end;
  102.  
  103.   function XGlobalDosAlloc(Size : longint; var P : Pointer) : word;
  104.   { Allocates memory in an area that DOS can access properly }
  105.   var Long : longint;
  106.   begin
  107.     Long := GlobalDosAlloc(Size);
  108.     P := Ptr(LongRec(Long).Selector, 0);
  109.     XGlobalDosAlloc := LongRec(Long).Segment;
  110.   end;
  111.  
  112.   function SimulateRealModeInt(IntNo : word;
  113.                                var Regs : TDPMIRegisters) : word; assembler;
  114.   { Simulates a real mode interrupt }
  115.   asm
  116.     PUSH BP                                          { Save BP, just in case }
  117.     MOV BX,IntNo                         { Move the Interrupt number into BX }
  118.     XOR CX,CX                                                     { Clear CX }
  119.     LES DI,Regs                              { Load the registers into ES:DI }
  120.     MOV AX,$300                                { Set function number to 300h }
  121.     INT $31                             { Call Interrupt 31h - DPMI Services }
  122.     JC @Exit                                         { Jump to exit on carry }
  123.     XOR AX,AX                                                     { Clear AX }
  124.     @Exit:                                                      { Exit label }
  125.     POP BP                                                      { Restore BP }
  126.   end;
  127.  
  128.   function LoadFont(FileName : string) : boolean;
  129.   { Loads a 255-character font from FileName to font 0 and sets it on }
  130.   var FontFile : file;
  131.       Font, Tmp : pointer;
  132.       S, O, FontSize, RMSeg, DPSel : word;
  133.       BPC : byte;
  134.       Regs : TDPMIRegisters;
  135.   begin
  136.     {$I-}
  137.     Assign(FontFile, FileName);                              { Open the file }
  138.     Reset(FontFile, 1);                                           { Reset it }
  139.     {$I+}
  140.     If (IOResult <> 0) then                  { File opening was unsuccessful }
  141.     begin
  142.       LoadFont := FALSE;                                      { Return FALSE }
  143.       Exit;                                               { Return to caller }
  144.     end;
  145.     FontSize := FileSize(FontFile);                      { Get the font size }
  146.     FillChar(Regs, SizeOf(Regs), #0);             { Clear the DPMI registers }
  147.     Regs.ES := XGlobalDosAlloc(FontSize, Font);            { Allocate memory }
  148.     BlockRead(FontFile, Font^, FontSize);                    { Load the font }
  149.     BPC := FontSize DIV 256;                 { Calculate bytes per character }
  150.     Close(FontFile);                                   { Close the font file }
  151.     DoubleWord(Regs.EBP).Hi := Regs.ES;       { Load font address into ES:BP }
  152.     QuadrupleByte(Regs.EAX).Hi := $11;                    { Set function $11 }
  153.     QuadrupleByte(Regs.EAX).Lo := $10;                { Set sub-function $10 }
  154.     QuadrupleByte(Regs.EBX).Hi := BPC;        { Set # of bytes per character }
  155.     QuadrupleByte(Regs.EBX).Lo := LoadBank;           { Set font number to 0 }
  156.     DoubleWord(Regs.ECX).Lo := $FF;               { # of chars to load = 256 }
  157.     DoubleWord(Regs.EDX).Lo := $0;                     { Set start char to 0 }
  158.     SimulateRealModeInt($10, Regs);                     { Call the interrupt }
  159.     GlobalDosFree(LongRec(Font).Selector);              { Free up the memory }
  160.     LoadFont := TRUE;                   { Return TRUE - function successful! }
  161.   end;
  162. {$ENDIF}
  163.  
  164. {$IFDEF MSDOS}
  165.   function LoadFont(FileName : string) : boolean;
  166.   { Loads a 255-character font from FileName to font 0 and sets it on }
  167.   var FontFile : file;
  168.       Font, Tmp : pointer;
  169.       S, O, FontSize, RMSeg, DPSel : word;
  170.       BPC : byte;
  171.   begin
  172.     {$I-}
  173.     Assign(FontFile, FileName);                              { Open the file }
  174.     Reset(FontFile, 1);                                           { Reset it }
  175.     {$I+}
  176.     If (IOResult <> 0) then                  { File opening was unsuccessful }
  177.     begin
  178.       LoadFont := FALSE;                                      { Return FALSE }
  179.       Exit;                                               { Return to caller }
  180.     end;
  181.     FontSize := FileSize(FontFile);                      { Get the font size }
  182.     GetMem(Font, FontSize);                       { Allocate memory for font }
  183.     BlockRead(FontFile, Font^, FontSize);                    { Load the font }
  184.     BPC := FontSize DIV 256;                 { Calculate bytes per character }
  185.     Close(FontFile);                                   { Close the font file }
  186.     S := Seg(Font^);                                   { Get segment of font }
  187.     O := Ofs(Font^);                                    { Get offset of font }
  188.     asm
  189.       PUSH BP                                                      { Save BP }
  190.       MOV AL,$10                                      { Set sub-function $10 }
  191.       MOV AH,$11                                          { Set function $11 }
  192.       MOV BH,BPC                              { Set # of bytes per character }
  193.       MOV BL,LoadBank                                   { Set font # to load }
  194.       MOV CX,$FF                                    { Set # of chars to load }
  195.       MOV DX,$0                           { Set start of load to character 0 }
  196.       MOV ES,S                                { Load segment of font to load }
  197.       MOV BP,O                                 { Load offset of font to load }
  198.       INT $10                                      { Call BIOS Interrupt 10h }
  199.       POP BP                                                    { Restore BP }
  200.     end;
  201.     FreeMem(Font, FontSize);                      { Release allocated memory }
  202.     LoadFont := TRUE;                   { Return TRUE - function successful! }
  203.   end;
  204. {$ENDIF}
  205.  
  206.   procedure Set2FontMode; assembler;
  207.   { Puts the VGA into double-font mode.  The first font should be contained
  208.     in bank 0, and the second in bank 6. }
  209.   asm
  210.     MOV AL,$03                                  { Set register offset to 03h }
  211.     MOV DX,$3C4                                    { Set output port to 3C4h }
  212.     OUT DX,AL                                  { Send our command to the VGA }
  213.     INC DX                           { Increment port to 3C5h, the data port }
  214.     MOV AL,$12                                { Put our 'magic byte' into AL }
  215.     OUT DX,AL                             { Send the 'magic byte' to the VGA }
  216.   end;
  217.  
  218.   procedure SetNormalFontMode; assembler;
  219.   { Puts the VGA back into normal single-font mode. }
  220.   asm
  221.     MOV AL,$03                                  { Set register offset to 03h }
  222.     MOV DX,$3C4                                    { Set output port to 3C4h }
  223.     OUT DX,AL                                  { Send the command to the VGA }
  224.     INC DX                           { Increment port to 3C5h, the data port }
  225.     MOV AL,$00                           { Put 00h into AL, all bets are off }
  226.     OUT DX,AL                                  { Send our command to the VGA }
  227.   end;
  228.  
  229.   procedure NormalFont; assembler;
  230.   { Returns the system to the normal system 8x16 character font }
  231.   asm
  232.     MOV AL,$04                                        { Set sub-function 04h }
  233.     MOV AH,$11                                            { Set function 11h }
  234.     MOV BL,$00                           { Select font 0 as the one to reset }
  235.     INT $10                                        { Call BIOS Interrupt 10h }
  236.   end;
  237.  
  238. begin
  239.   LoadBank := $00;                              { Set default load bank to 0 }
  240. end.
  241.